home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / UTILFILE / DISKVAC.LZH / DISKVAC.BAS next >
BASIC Source File  |  1989-02-01  |  11KB  |  424 lines
  1.    DEFINT A-Z: ON ERROR GOTO ANYERROR
  2.    D$ = UCASE$(COMMAND$)
  3.  
  4.    IF LEN(D$) = 1 AND D$ > "@" AND LEFT$(D$, 1) < "Z" THEN
  5.      D$ = D$ + ":": COLOR 15, 1: CLS
  6.     ELSE
  7.     SOUND 1700, 2: PRINT "Syntax: DISKVAC [drive]"; : END
  8.    END IF
  9.   
  10.  ' -- Program Initialization --
  11.   DIM SUB$(1000), CDIR$(500), TDIR$(500)
  12.   DIM INREG%(7), OUTREG%(7), MC$(3), M$(4)
  13.   SBAR$ = STRING$(41, 196): MBAR$ = STRING$(41, 205)
  14.   BLANK$ = STRING$(41, 32): W$ = CHR$(186)
  15.   M$(1) = CHR$(218) + SBAR$ + CHR$(191)
  16.   M$(2) = CHR$(179) + BLANK$ + CHR$(179)
  17.   M$(3) = CHR$(192) + SBAR$ + CHR$(217)
  18.   M$(4) = CHR$(195) + SBAR$ + CHR$(180)
  19.   MC$(1) = CHR$(201) + MBAR$ + CHR$(187)
  20.   MC$(2) = W$ + "    (C)ontinue     (D)elete     (E)xit   " + W$
  21.   MC$(3) = CHR$(200) + MBAR$ + CHR$(188)
  22.   HEADER$ = "Filename Ext    Size   Date      Time"
  23.   GOSUB GETFREESPACE: GOSUB DISPLAYSCREEN: GOSUB DISPLAYSCREEN1
  24.  
  25.   DO
  26.   GOSUB RPROMPT
  27.   COLOR 15, 1: LOCATE 17, 20: PRINT "<1> Selected Search ";
  28.            LOCATE 18, 20: PRINT "<2> Find Duplicate Files ";
  29.            LOCATE 19, 20: PRINT "<3> Quit ";
  30.  DO
  31.     X$ = INKEY$
  32.     X$ = UCASE$(RIGHT$(X$, 1))
  33.      SELECT CASE X$
  34.        CASE "1"
  35.     GOSUB RPROMPT: GOSUB ADDONE
  36.     GOSUB GETDIRS: GOSUB SELECTED
  37.      EXIT DO
  38.        CASE "2"
  39.      GOSUB RPROMPT: GOSUB GETDIRS
  40.      GOSUB GETDUPLICATES
  41.      EXIT DO
  42.        CASE "3"
  43.      IF WORKED THEN
  44.        KILL "DIRECT.DOC"
  45.        KILL "DIRTREE.DOC"
  46.      END IF
  47.        CLS : SYSTEM
  48.    CASE ELSE
  49.       END SELECT
  50.  LOOP
  51.  
  52.   CLS : GOSUB DISPLAYSCREEN: GOSUB DISPLAYSCREEN1: WORKED = 1
  53.   COLOR 15, 4: LOCATE 16, 21: PRINT "    SEARCH COMPLETE    ";
  54.   COLOR 15, 1: LOCATE 17, 21: PRINT " Log a new drive? (y/n)";
  55.  
  56.     DO
  57.      X$ = INKEY$
  58.     X$ = UCASE$(RIGHT$(X$, 1))
  59.      SELECT CASE X$
  60.       CASE "Y"
  61.          GOSUB NEWDRIVE: EXIT DO
  62.       CASE "N"
  63.          GOSUB RPROMPT: EXIT DO
  64.       CASE ELSE
  65.     END SELECT
  66.     LOOP
  67.  LOOP
  68.  
  69.  ' -- Log new drive --
  70. NEWDRIVE:
  71.    GOSUB RPROMPT: COLOR 15, 1
  72.    LOCATE 16, 15: INPUT "Drive letter "; D$
  73.  
  74.    D$ = UCASE$(D$)
  75.    IF LEN(D$) = 1 AND D$ > "@" AND D$ < "Z" THEN
  76.       D$ = D$ + ":": RETURN
  77.      ELSE
  78.       SOUND 700, 1: GOTO NEWDRIVE
  79.    END IF
  80.    
  81.  '-- Build directory tree  --
  82. GETDIRS:
  83.    ERASE SUB$, CDIR$, TDIR$
  84.    DIRCOUNT = 1: SUB$(DIRCOUNT) = "\"
  85.    DIRCOUNT = DIRCOUNT + 1
  86.    LOCATE 16, 20: COLOR 15, 4
  87.    PRINT "Building Directory Tree "; : COLOR 15, 1
  88.    LOCATE 17, 20
  89.  
  90.    SHELL "TREE " + D$ + " > DIRTREE.DOC"
  91.    OPEN "DIRTREE.DOC" FOR INPUT AS #1
  92.  
  93.    DO WHILE NOT EOF(1)
  94.     LINE INPUT #1, A$
  95.      IF INSTR(A$, "\") THEN
  96.      TEMPDIR$ = ""
  97.      FOR JW = 1 TO LEN(A$)
  98.        AA$ = MID$(A$, JW, 1)
  99.        IF AA$ > " " THEN TEMPDIR$ = TEMPDIR$ + AA$
  100.      NEXT
  101.      SUB$(DIRCOUNT) = RIGHT$(TEMPDIR$, LEN(TEMPDIR$) - 5)
  102.      DIRCOUNT = DIRCOUNT + 1
  103.      END IF
  104.    LOOP
  105.    GOSUB RPROMPT: CLOSE 1: RETURN
  106.  ' -- Add a new search string --
  107. ADDONE:
  108.   COLOR 15, 1
  109.   LOCATE 17, 21: PRINT " Add a search string ? (y/n)";
  110.    DO
  111.      X$ = INKEY$
  112.     X$ = UCASE$(RIGHT$(X$, 1))
  113.      SELECT CASE X$
  114.       CASE "Y"
  115.        GOSUB SFILE: GOSUB RPROMPT: EXIT DO
  116.        CASE "N"
  117.          GOSUB RPROMPT: EXIT DO
  118.       CASE ELSE
  119.     END SELECT
  120.     LOOP
  121.   RETURN
  122.  
  123.  ' -- Check entries for string matches --
  124. SELECTED:
  125.  DIR = 1
  126.    WHILE DIR < DIRCOUNT
  127.     LOCATE 3, 27: PRINT STRING$(28, 32); : LOCATE 3, 27
  128.       COLOR 15, 4: PRINT D$; SUB$(DIR); : COLOR 15, 1
  129.  
  130.       SHELL "DIR " + D$ + SUB$(DIR) + " >DIRECT.DOC"
  131.       OPEN "DIRECT.DOC" FOR INPUT AS #1
  132.  
  133.        DUMPLINES = 0
  134.        WHILE DUMPLINES < 6
  135.          LINE INPUT #1, BYPASS$
  136.          DUMPLINES = DUMPLINES + 1
  137.        WEND
  138.  
  139. '-- Check for matching string mask --
  140.   DO WHILE NOT EOF(1)
  141.     LINE INPUT #1, F$
  142.      IF LEFT$(F$, 1) <> " " AND MID$(F$, 14, 1) <> "<" THEN
  143.        IF INSTR(F$, " BAK ") THEN MATCH = 1
  144.        IF INSTR(F$, " $$$ ") THEN MATCH = 1
  145.        IF INSTR(F$, " BK! ") THEN MATCH = 1
  146.        IF INSTR(F$, " TMP ") THEN MATCH = 1
  147.        IF MASK$ > "" THEN IF INSTR(F$, MASK$) THEN MATCH = 1
  148.     COLOR 15, 4: LOCATE 10, 14: PRINT F$; : COLOR 15, 1
  149.        IF MATCH THEN MATCH = 0: GOSUB ASK
  150.        IF CUT THEN CUT = 0: COLOR 15, 1: CLOSE 1: RETURN
  151.      END IF
  152.   LOOP
  153.     CLOSE 1: DIR = DIR + 1
  154.  WEND
  155. RETURN
  156.  
  157. ASK:
  158.   COLOR 24, 15: LOCATE 10, 14: PRINT F$; : COLOR 15, 1
  159.   GOSUB DPROMPT
  160. ASK1:
  161.  DO
  162.    X$ = INKEY$
  163.     X$ = UCASE$(RIGHT$(X$, 1))
  164.       SELECT CASE X$
  165.      CASE "C"
  166.        GOSUB RPROMPT: RETURN
  167.      CASE "D"
  168.        GOSUB DELETE: GOSUB RPROMPT: RETURN
  169.      CASE "E"
  170.        CUT = 1: GOSUB RPROMPT: RETURN
  171.      CASE ELSE
  172.      END SELECT
  173.  LOOP
  174.  '-- Display menu box --
  175. DPROMPT:
  176.     FOR ROW = 17 TO 19
  177.       LOCATE ROW, 13: PRINT MC$(ROW - 16);
  178.     NEXT
  179.     RETURN
  180.  
  181. '-- Erase menu box --
  182. RPROMPT:
  183.     FOR ROW = 16 TO 24
  184.       LOCATE ROW, 1: PRINT STRING$(80, 32);
  185.     NEXT
  186.     LOCATE 16, 20, 0: RETURN
  187. ' -- Delete file routine --
  188. DELETE:
  189.  IF DUP THEN
  190.    IF CURDIR = 1 THEN SUB$(CURDIR) = ""
  191.    GOSUB PRINTCHOICES
  192.   ELSE
  193.    LOCATE 16, 20
  194.    COLOR 15, 4: PRINT "Delete this file (y/n) ?";
  195.    COLOR 15, 1
  196.  END IF
  197.  
  198.  DO
  199.   X$ = INKEY$
  200.      X$ = UCASE$(RIGHT$(X$, 1))
  201.      SELECT CASE X$
  202.        CASE "Y"
  203.       IF DIR = 1 THEN SUB$(DIR) = ""
  204.       THISDIR$ = SUB$(DIR)
  205.       GOSUB STRIP: GOSUB KILLFILE: RETURN
  206.        CASE "N"
  207.       RETURN
  208.        CASE "1"
  209.       IF DUP THEN
  210.         THISDIR$ = SUB$(CURDIR)
  211.         F$ = CDIR$(DIR): GOSUB STRIP
  212.         GOSUB KILLFILE
  213.         GOSUB RPROMPT: RETURN
  214.       END IF
  215.        CASE "2"
  216.       IF DUP THEN
  217.         THISDIR$ = SUB$(TAGDIR)
  218.         F$ = TDIR$(MC): GOSUB STRIP
  219.         GOSUB KILLFILE: GOSUB RPROMPT: RETURN
  220.        END IF
  221.        CASE "3"
  222.       IF DUP THEN
  223.        GOSUB RPROMPT: RETURN
  224.       END IF
  225.        CASE ELSE
  226.      END SELECT
  227.  LOOP
  228.  
  229.  ' -- Kill selected file --
  230. KILLFILE:
  231.   GOSUB GETFREESPACE
  232.   OLDSPACE# = FREESPACE#
  233.   OLDFREE# = NEWSPACE#
  234.   KILL D$ + THISDIR$ + "\" + FILENAME$
  235.   GOSUB GETFREESPACE
  236.   NEWSPACE# = FREESPACE# - OLDSPACE#
  237.   NEWSPACE# = NEWSPACE# + OLDFREE#
  238.   LOCATE 4, 27: PRINT FREESPACE#;
  239.   LOCATE 5, 27: PRINT NEWSPACE#;
  240.   RETURN
  241.  ' -- Select new search mask string --
  242. SFILE:
  243.  GOSUB RPROMPT: COLOR 15, 1
  244.  LOCATE 16, 15: INPUT "Enter search string: "; MASK$
  245.  MASK$ = UCASE$(MASK$)
  246.  LOCATE 16, 15: PRINT STRING$(26, 32); : RETURN
  247.  
  248.  ' -- Calculate free disk space --
  249. GETFREESPACE:
  250.    DRIVE = ASC(LEFT$(D$, 1)) - 64
  251.    INREG%(0) = &H3600: INREG%(1) = DRIVE
  252.    CALL INT86OLD(&H21, INREG%(), OUTREG%())
  253.    IF OUTREG%(0) = &HFFFF THEN BEEP: BEEP: RETURN
  254.    SECTORSPERCLUSTER = OUTREG%(0)
  255.    FREECLUSTERS! = OUTREG%(1)
  256.    BYTESPERSECTOR = OUTREG%(2)
  257.    TOTALCLUSTERS! = OUTREG%(3)
  258.    SECTORS! = FREECLUSTERS! * SECTORSPERCLUSTER
  259.    FREESPACE# = SECTORS! * BYTESPERSECTOR
  260.    RETURN
  261.  
  262. ' -- Extract filename from directory string --
  263. STRIP:
  264.     LOCATE 22, 14: PRINT STRING$(20, 32);
  265.     NAME$ = RTRIM$(LEFT$(F$, 8))
  266.     EXT$ = RTRIM$(MID$(F$, 10, 3))
  267.  
  268.       IF EXT$ > "" THEN
  269.     FILENAME$ = NAME$ + "." + EXT$
  270.        ELSE FILENAME$ = NAME$
  271.       END IF
  272.      RETURN
  273.  
  274. '-- Locate files with duplicate names --
  275. GETDUPLICATES:
  276.    GOSUB DISPLAYMATCH: GOSUB DISPLAYSCREEN: NUMDIR = 1
  277.    COLOR 15, 4: LOCATE 3, 14: PRINT "<ESC> to abort search";
  278.    COLOR 15, 1
  279.  
  280.    WHILE SUB$(NUMDIR) > ""
  281.      NUMDIR = NUMDIR + 1
  282.    WEND
  283.  
  284.    IF NUMDIR = 1 THEN RETURN
  285. ' -- Evaluate directory entries --
  286.  CURDIR = 1: AD = 1: TAGDIR = CURDIR + 1: MC = 1
  287.  
  288. WHILE AD < NUMDIR
  289.   GOSUB GETINDEX
  290.      WHILE TAGDIR < NUMDIR
  291.     GOSUB GETSEARCH
  292.     DIR = 1
  293.  
  294.        DO WHILE DIR <= LASTCUR
  295.  
  296.     IF INSTR(CDIR$(DIR), "<") = 0 THEN
  297.        COLOR 15, 4: LOCATE 10, 14: PRINT CDIR$(DIR);
  298.     END IF
  299.  
  300.        DO WHILE MC <= LASTTAG
  301.  
  302.     IF INSTR(TDIR$(MC), "<") = 0 THEN
  303.        COLOR 15, 4: LOCATE 14, 14: PRINT TDIR$(MC);
  304.      IF LEFT$(TDIR$(MC), 12) = LEFT$(CDIR$(DIR), 12) THEN
  305.         IF CUT THEN CUT = 0: COLOR 15, 1: RETURN
  306.         GOSUB DISPLAYNAMES
  307.      END IF
  308.     END IF
  309.       MC = MC + 1
  310.        LOOP
  311.          DIR = DIR + 1: MC = 1
  312.      LOOP
  313.          TAGDIR = TAGDIR + 1
  314.   WEND
  315.          AD = AD + 1: CURDIR = CURDIR + 1
  316.          TAGDIR = CURDIR + 1
  317. WEND
  318. RETURN
  319.  
  320.  ' -- Get index directory entries --
  321. GETINDEX:
  322.     DUMPLINES = 0: COLOR 15, 1
  323.     LOCATE 8, 14: PRINT STRING$(62, 32); : COLOR 15, 4
  324.     LOCATE 8, 14: PRINT "INDEX: "; D$; SUB$(CURDIR);
  325.     COLOR 15, 1
  326.     
  327.     SHELL "DIR " + D$ + SUB$(CURDIR) + " >DIRECT.DOC"
  328.     OPEN "DIRECT.DOC" FOR INPUT AS #1
  329.  
  330. ' -- Skip first 6 lines of ASCII file --
  331.      WHILE DUMPLINES < 6
  332.        LINE INPUT #1, A$
  333.      DUMPLINES = DUMPLINES + 1
  334.       WEND
  335.  
  336.   COUNTER = 0
  337.   DO WHILE COUNTER < 501 AND NOT EOF(1)
  338.       COUNTER = COUNTER + 1
  339.        LINE INPUT #1, CDIR$(COUNTER)
  340.   LOOP
  341.  
  342.   LASTCUR = COUNTER - 1
  343.   CLOSE 1: RETURN
  344. ' -- Get search directory entries --
  345. GETSEARCH:
  346.   X$ = INKEY$
  347.    IF X$ = CHR$(27) THEN CUT = 1
  348.  
  349.    DUMPLINES = 0
  350.  
  351.    COLOR 15, 1
  352.    LOCATE 12, 14: PRINT STRING$(62, 32); : COLOR 15, 4
  353.    LOCATE 12, 14: PRINT "SEARCHING: "; D$; SUB$(TAGDIR);
  354.    COLOR 15, 1
  355.  
  356.     SHELL "DIR " + D$ + SUB$(TAGDIR) + " >DIRECT.DOC"
  357.      OPEN "DIRECT.DOC" FOR INPUT AS #1
  358.  
  359.       WHILE DUMPLINES < 6
  360.        LINE INPUT #1, A$
  361.      DUMPLINES = DUMPLINES + 1
  362.       WEND
  363.  ' -- Gather entries from search directory --
  364.    COUNTER = 0
  365.    DO WHILE COUNTER < 501 AND NOT EOF(1)
  366.       COUNTER = COUNTER + 1
  367.        LINE INPUT #1, TDIR$(COUNTER)
  368.    LOOP
  369.    LASTTAG = COUNTER - 1: CLOSE 1: RETURN
  370.  
  371.  ' -- Display matching filenames --
  372. DISPLAYNAMES:
  373.   COLOR 24, 15
  374.   LOCATE 10, 14: PRINT CDIR$(DIR);
  375.   LOCATE 14, 14: PRINT TDIR$(MC);
  376.   COLOR 15, 1: GOSUB DPROMPT: SOUND 300, .5
  377.   DUP = 1: GOSUB ASK1: DUP = 0: RETURN
  378.  
  379.  ' -- Display workscreen --
  380. DISPLAYSCREEN:
  381.   LOCATE 2, 13: PRINT M$(1); : ROW = 3
  382.    WHILE ROW < 6
  383.     LOCATE ROW, 13: PRINT M$(2);
  384.     ROW = ROW + 1
  385.   WEND
  386.   LOCATE 6, 13: PRINT M$(3)
  387.   LOCATE 3, 14: PRINT "Drive/Path : ";
  388.   LOCATE 4, 14: PRINT "Bytes Free : "; FREESPACE#;
  389.   LOCATE 5, 14: PRINT "Reclaimed  :"; NEWSPACE#;
  390.   RETURN
  391.  
  392. DISPLAYSCREEN1:
  393.   LOCATE 7, 13: PRINT M$(1); : LOCATE 8, 13: PRINT M$(2);
  394.   LOCATE 9, 13: PRINT M$(4); : LOCATE 10, 13: PRINT M$(2);
  395.   LOCATE 11, 13: PRINT M$(3); : LOCATE 8, 15: PRINT HEADER$;
  396.   RETURN
  397.  
  398. DISPLAYMATCH:
  399.   COLOR 15, 1: CLS : GOSUB DISPLAYSCREEN
  400.   FOR ROW = 9 TO 11
  401.     LOCATE ROW, 13: PRINT M$(ROW - 8);
  402.   NEXT
  403.   FOR ROW = 13 TO 15
  404.     LOCATE ROW, 13: PRINT M$(ROW - 12);
  405.   NEXT
  406.   RETURN
  407.  
  408. PRINTCHOICES:
  409.   GOSUB RPROMPT: COLOR 15, 4
  410.   F3$ = RTRIM$(MID$(CDIR$(DIR), 10, 3))
  411.   F4$ = RTRIM$(MID$(TDIR$(MC), 10, 3))
  412.   F1$ = RTRIM$(LEFT$(CDIR$(DIR), 8)) + "." + F3$
  413.   F2$ = RTRIM$(LEFT$(TDIR$(MC), 8)) + "." + F4$
  414.  
  415.   LOCATE 16, 20: PRINT "       DELETE       ": COLOR 15, 1
  416.   PRINT TAB(19); "<1> "; D$; SUB$(CURDIR); "\"; F1$
  417.   PRINT TAB(19); "<2> "; D$; SUB$(TAGDIR); "\"; F2$
  418.   PRINT TAB(19); "<3>  CONTINUE"
  419.   RETURN
  420. ANYERROR:
  421.    CLOSE : CLS : SYSTEM
  422.  
  423.  
  424.